﻿Imports OpenNETCF
Imports System.Runtime.InteropServices

Module ExtendedGraphicsMethods
  Private Declare Function GetWindowLong Lib "coredll.dll" (ByVal hWnd As IntPtr, ByVal index As Integer) As Integer
  Private Declare Sub SetWindowLong Lib "coredll.dll" (ByVal hwnd As IntPtr, ByVal index As Integer, ByVal value As Integer)
  Private Declare Function DrawText Lib "coredll.dll" (ByVal hdc As IntPtr, ByVal lpstr As String, ByVal nCount As Integer, ByRef lpRect As RECT, ByVal wFormat As Integer) As Integer
  Private Declare Function DeleteObject Lib "coredll.dll" (ByVal objectHandle As IntPtr) As Boolean
  Private Declare Function SelectObject Lib "coredll.dll" (ByVal hdc As IntPtr, ByVal hgdiobj As IntPtr) As IntPtr

  Private Const GWL_STYLE As Integer = -16
  Private Const SS_NOPREFIX As Integer = &H80
  Private Const DT_CALCRECT As Integer = &H400
  Private Const DT_WORDBREAK As Integer = &H10
  Private Const DT_EDITCONTROL As Integer = &H2000

  Private gdipInput As GDIPlus.GdiplusStartupInput = Nothing
  Private gdipOutput As GDIPlus.GdiplusStartupOutput = Nothing
  Private gdipToken As IntPtr = IntPtr.Zero

  <StructLayout(LayoutKind.Sequential)> _
  Private Structure RECT
    Dim Left, Top, Right, Bottom As Integer

    Sub New(ByVal r As Rectangle)
      Left = r.Left
      Right = r.Right
      Top = r.Top
      Bottom = r.Bottom
    End Sub
  End Structure

  ''' <summary>
  ''' Initialize the GDI Plus subsystem (if GDI+ is not available, nothing is done)
  ''' </summary>
  Public Sub InitGDIPlus()
    Try
      gdipInput = New GDIPlus.GdiplusStartupInput()
      gdipOutput = New GDIPlus.GdiplusStartupOutput()
      GDIPlus.NativeMethods.GdiplusStartup(gdipToken, gdipInput, gdipOutput)
    Catch
      gdipInput = Nothing
      gdipOutput = Nothing
      gdipToken = IntPtr.Zero
    End Try
  End Sub

  ''' <summary>
  ''' De-initialize the GDI Plus subsystem
  ''' </summary>
  Public Sub ShutdownGDIPlus()
    If gdipToken <> IntPtr.Zero Then
      Try
        GDIPlus.NativeMethods.GdiplusShutdown(gdipToken)
      Finally
        gdipInput = Nothing
        gdipOutput = Nothing
        gdipToken = IntPtr.Zero
      End Try
    End If
  End Sub

  ''' <summary>
  ''' Scales srcBmp to fit into the dimensions of destBmp.  If GDI+ is available and initialzied (use InitGDIPlus()), high quality
  ''' scaling will be used, otherwise standard GDI scaling is used.
  ''' </summary>
  ''' <param name="destBmp">The bitmap that will be overdrawn with the srcBmp.  This bitmap's dimensions indicate the final scaled size.</param>
  ''' <param name="srcBmp">The bitmap that is going to be scaled.</param>
  ''' <remarks></remarks>
  Public Sub ScaleBitmap(ByVal destBmp As Bitmap, ByVal srcBmp As Bitmap)
    'Dim usegdip As Boolean = (gdipToken <> IntPtr.Zero)

    Using g As Graphics = Graphics.FromImage(destBmp)
      '  ' Use high quality (GDI+) scaling
      '  If usegdip Then
      '    Dim hdc As IntPtr = g.GetHdc
      '    Try
      '      Using gp As GDIPlus.GraphicsPlus = GDIPlus.GraphicsPlus.FromHDC(hdc) ' Create a GDI+ graphics object based on the destBmp's graphics object
      '        gp.SetSmoothingMode(GDIPlus.SmoothingMode.SmoothingModeAntiAlias)
      '        Using ms As New IO.MemoryStream ' memory stream to store a bitmap file derived from the srcBmp
      '          srcBmp.Save(ms, Drawing.Imaging.ImageFormat.Jpeg) ' Save the bitmap into the memory stream
      '          ms.Seek(0, IO.SeekOrigin.Begin)
      '          Using istr As New GDIPlus.StreamOnFile(ms) ' Load the memory stream bitmap into the GDI+ stream
      '            Using ip As New GDIPlus.BitmapPlus(istr) ' Create the GDI+ image object from the stream
      '              ' Draw the scaled image, using the high quality anti-alias mode
      '              gp.DrawImage(ip, New GDIPlus.GpRect(0, 0, destBmp.Width, destBmp.Height), 0, 0, srcBmp.Width, srcBmp.Height, GDIPlus.Unit.UnitPixel, New GDIPlus.ImageAttributesPlus)
      '            End Using
      '          End Using
      '          ms.Close()
      '        End Using
      '      End Using
      '    Catch
      '      usegdip = False ' Something failed, so use classic GDI
      '    Finally
      '      Try : g.ReleaseHdc(hdc) : Catch : End Try
      '    End Try
      '  End If

      '  ' Use low quality standard scaling
      '  If Not usegdip Then
      g.DrawImage(srcBmp, New Rectangle(0, 0, destBmp.Width, destBmp.Height), New Rectangle(0, 0, srcBmp.Width, srcBmp.Height), GraphicsUnit.Pixel)
      '  End If
    End Using
  End Sub

  ''' <summary>
  ''' Sets the mnemonic property on a CF label control (determines whether to draw or underline with an ampersand)
  ''' </summary>
  ''' <param name="lbl">The label control to modify the property on</param>
  ''' <param name="value">Whether the mnemonic property should be enabled (underline character after the ampersand)</param>
  Public Sub UseMnemonic(ByVal lbl As Label, ByVal value As Boolean)
    If lbl IsNot Nothing Then
      Dim style As Integer = GetWindowLong(lbl.Handle, GWL_STYLE)
      If value Then
        style = style And (Not SS_NOPREFIX)
      Else
        style = style Or SS_NOPREFIX
      End If
      SetWindowLong(lbl.Handle, GWL_STYLE, style)
    End If
  End Sub

  ''' <summary>
  ''' Performs a measurement of a string item within a constrained rectangle -- such as for multiline text.  The compact framework does not
  ''' offer this method in the graphics object, so that's why this method is useful.  It uses interop on DrawText to perform the calculation.
  ''' </summary>
  ''' <param name="g">The graphics context to use</param>
  ''' <param name="text">The text to measure</param>
  ''' <param name="tRect">The rectangle which represents the text's bounds</param>
  ''' <param name="textBoxControl">A flag to indicate if this is a textbox control (adds necessary padding automatically, if true)</param>
  ''' <returns>A size object containing the dimensions of the string</returns>
  Public Function MeasureString(ByVal g As Graphics, ByVal text As String, ByVal tRect As Rectangle, ByVal tFnt As Font, Optional ByVal textBoxControl As Boolean = False) As Size
    Dim bounds As New RECT(tRect)
    Dim hdc As IntPtr = g.GetHdc
    Dim hFont As IntPtr = tFnt.ToHfont
    Dim flags As Integer = DT_CALCRECT Or DT_WORDBREAK
    Dim hOldFont As IntPtr = SelectObject(hdc, hFont)

    If textBoxControl Then flags = flags Or DT_EDITCONTROL
    DrawText(hdc, text, text.Length, bounds, flags)

    SelectObject(hdc, hOldFont)
    DeleteObject(hFont)
    g.ReleaseHdc(hdc)

    Return New Size(bounds.Right - bounds.Left, bounds.Bottom - bounds.Top + CInt(IIf(textBoxControl, 6, 0)))
  End Function

End Module
